000100 IDENTIFICATION DIVISION.
000200 PROGRAM-ID.          HHOPN160.
000300*AUTHOR.             DDS TEAM.
000400*                        CMS.
000500******************************************************************
000600*REMARKS.
000700*     HHDRV040   NATIONAL HHA FOR OCT 1, 2003
000800*                LOADS ALL FILES
000900*                     HRG , REVENUE , MSA TABLES
001000*                MSA = ML00.@DBA2652.WIPREREC.#020709.M2
001100*                      APPLYING FY 2003 INDEX IN FY 2004
001200*                      FY 2003 WAGE INDEX
001300*                      PRE-RECLASSIED AND PRE-FLOOR
001400*     HHDRV041 NEW RATES APR 1, 2004
001500*     HHDRV050 NEW RATES JAN 1, 2005
001600*              MSA = ML00.@DBA2652.WI2005.PFPREC.#041030.SCR401U
001700*                    APPLYING CY 2005
001800*                    CY 2005 WAGE INDEX
001900*                    PRE-RECLASSIED AND PRE-FLOOR
002000*     HHDRV060 NEW RATES JAN 1, 2006
002100*             CBSA = ML00.@DBA2652.WI06.CBSA.#050301.SNF-STANLY
002200*                    APPLYING CY 2006
002300*                    CY 2006 WAGE INDEX
002400*                    PRE-RECLASSIED AND PRE-FLOOR
002500*     HHDRV061 NEW RATES JAN 1, 2006
002600*              CY 2006 WAGE INDEX
002700*              PRE-RECLASSIED AND PRE-FLOOR RURAL DIFFERENTIAL
002800*     HHDRV062 ADDED RURAL DIFFERENTIAL LOGIC FOR SPECIFIC CBSA
002900*              CODES, INITIALIZE THE TABLES BEFORE LOADING
003000*     HHOPN063 NEW CICS  APR 1, 2006 - CICS VERSION
003100*     HHOPN070 NEW CICS  JAN 1, 2007 - CICS VERSION
003200*     HHOPN071 NEW CICS  JAN 1, 2007 - CICS VERSION
003300*              CORRECT LUPA RATE DETERMINATION IF LOGIC
003400*     HHOPN083 NEW CICS  JAN 1, 2008 - CICS VERSION
003500*              CORRECT LUPA RATE DETERMINATION IF LOGIC
003600*              CORRECT LUPA CALCULATION FOR REJECTED AND
003700*              REPROCESSED CLAIMS
003800*     HHOPN084 NEW CICS  JAN 1, 2008 - CICS VERSION
003900*              CORRECT HIPPS CODE RECODING LOGIC AND LUPA
004000*              RECODING LOGIC. THIS PROGRAM REFECTS CHANGES TO
004100*              RELEASE LEVEL ONLY
004200*     HHOPN090 NEW CICS  JAN 1, 2009 - CICS VERSION
004300*              CORRECT HIPPS CODE RECODING LOGIC AND LUPA
004400*              RECODING LOGIC. THIS PROGRAM REFECTS CHANGES TO
004500*              RELEASE LEVEL ONLY
004600*     HHOPN091 LUPA ADD ON ZERO WHEN REV VISITS = ZERO
004700*     HHOPN092 CHANGE IN HIPPS RECODING FOR 5 IN POS 1
004800*     HHDRV100 EXPAND BILLING RECORD TO 500 BYTES -
004900*     HHDRV101 LUPA FACTOR TRANSPOSITION FIX
005000*     HHDRV103 CORRECT SUPPLY ADD ON CODING.
005100*     HHDRV105 HEALTH CARE REFORM
005200*     HHDRV111 CY 2011
005300*     HHDRV120 CY 2012
005400*     HHDRV130 CY 2013
005500*     HHDRV130 CY 2014
005600*     HHOPN144 CY 2014.4 UPDATE
005600*     HHOPN152 CY 2015.2 UPDATE
005600*     HHOPN160 CY 2016.0 UPDATE
005700
005800***************************************************************
005900*     RETURN CODES
006000*          00 = FINAL PAYMENT
006100*               TOB = 329,339,327,337
006200*                  OR 32G OR 33G OR 32I OR 33I
006300*                  OR 32J OR 33J OR 32M OR 33M
006400*                  OR 32F OR 32K OR 32P OR 32H
006500*                  OR 33F OR 33K OR 33P OR 33H
006600*               WITH HRG,REVENUE CODE WHERE NO OUTLIER APPLIES
006700*          01 = FINAL PAYMENT
006800*               TOB = 329,339,327,337
006900*                  OR 32G OR 33G OR 32I OR 33I
007000*                  OR 32J OR 33J OR 32M OR 33M
007100*                  OR 32F OR 32K OR 32P OR 32H
007200*                  OR 33F OR 33K OR 33P OR 33H
007300*               WITH HRG,REVENUE CODE WHERE OUTLIER APPLIES
007400*          03 = INITIAL HALF PAYMENT PAYMENT WILL BE ZERO
007500*               TOB = 332 AND 322
007600*          04 = INITIAL HALF PAYMENT PAID AT 50%
007700*               TOB = 332 AND 322
007800*               WITH INITIAL (FIRST) HRG AND NO REVENUE CODES
007900*          05 = INITIAL HALF PAYMENT PAID AT 60%
008000*               TOB = 332 AND 322
008100*               WITH INITIAL (FIRST) HRG AND NO REVENUE CODES
008200*          06 = LUPA PAYMENT ONLY
008300*               TOB = 329,339,327,337
008400*                  OR 32G OR 33G OR 32I OR 33I
008500*                  OR 32J OR 33J OR 32M OR 33M
008600*                  OR 32F OR 32K OR 32P OR 32H
008700*                  OR 33F OR 33K OR 33P OR 33H
008800*               WITH REVENUE CODES AND REVENUE QTYS < 5       *
008900******************************************************************
009000**  RTC CODES 07,08,09,11,12,13 EFFECTIVE 10/01/2002          ****
009100******************************************************************
009200******************************************************************
009300*          07 = FINAL PAYMENT, SCIC, PEP = N, NO OUTLIER
009400*               TOB = 329,339,327,337
009500*                  OR 32G OR 33G OR 32I OR 33I
009600*                  OR 32J OR 33J OR 32M OR 33M
009700*                  OR 32F OR 32K OR 32P OR 32H
009800*                  OR 33F OR 33K OR 33P OR 33H
009900*               WITH REVENUE CODE WHERE NO OUTLIER APPLIES
010000*               WITH MORE THAN ONE HRG OCCURRENCE             *
010100*          08 = FINAL PAYMENT, SCIC, PEP = N, WITH OUTLIER
010200*               TOB = 329,339,327,337
010300*                  OR 32G OR 33G OR 32I OR 33I
010400*                  OR 32J OR 33J OR 32M OR 33M
010500*                  OR 32F OR 32K OR 32P OR 32H
010600*                  OR 33F OR 33K OR 33P OR 33H
010700*               WITH REVENUE CODE WHERE OUTLIER APPLIES
010800*               WITH MORE THAN ONE HRG OCCURRENCE             *
010900******************************************************************
011000*          09 = FINAL PAYMENT, PEP = Y, NO OUTLIER
011100*               TOB = 329,339,327,337
011200*                  OR 32G OR 33G OR 32I OR 33I
011300*                  OR 32J OR 33J OR 32M OR 33M
011400*                  OR 32F OR 32K OR 32P OR 32H
011500*                  OR 33F OR 33K OR 33P OR 33H
011600*               WITH REVENUE CODE WHERE NO OUTLIER APPLIES
011700*               WITH ONE HRG OCCURRENCE                       *
011800*          11 = FINAL PAYMENT, PEP = Y, WITH OUTLIER
011900*               TOB = 329,339,327,337
012000*                  OR 32G OR 33G OR 32I OR 33I
012100*                  OR 32J OR 33J OR 32M OR 33M
012200*                  OR 32F OR 32K OR 32P OR 32H
012300*                  OR 33F OR 33K OR 33P OR 33H
012400*               WITH REVENUE CODE WHERE OUTLIER APPLIES
012500*               WITH ONE HRG OCCURRENCE                       *
012600******************************************************************
012700*          12 = FINAL PAYMENT, SCIC, PEP = Y, NO OUTLIER
012800*               TOB = 329,339,327,337
012900*                  OR 32G OR 33G OR 32I OR 33I
013000*                  OR 32J OR 33J OR 32M OR 33M
013100*                  OR 32F OR 32K OR 32P OR 32H
013200*                  OR 33F OR 33K OR 33P OR 33H
013300*               WITH REVENUE CODE WHERE NO OUTLIER APPLIES
013400*               WITH MORE THAN ONE HRG OCCURRENCE             *
013500*          13 = FINAL PAYMENT, SCIC, PEP = Y, WITH OUTLIER
013600*               TOB = 329,339,327,337
013700*                  OR 32G OR 33G OR 32I OR 33I
013800*                  OR 32J OR 33J OR 32M OR 33M
013900*                  OR 32F OR 32K OR 32P OR 32H
014000*                  OR 33F OR 33K OR 33P OR 33H
014100*               WITH REVENUE CODE WHERE OUTLIER APPLIES
014200*               WITH MORE THAN ONE HRG OCCURRENCE             *
014300******************************************************************
014400******************************************************************
014500******************************************************************
014600******************************************************************
014700*                                                             *
014800*            HHA-RTC   NO PAYMENTS RETURNED                   *
014900*                                                             *
015000*              10 = INVALID TOB                               *
015100*                                                             *
015200*              15 = INVALID PEP DAYS                          *
015300*                   FOR SHORTENED EPISODE                     *
015400*                                                             *
015500*              20 = INVALID PEP INDICATOR                     *
015600*                                                             *
015700*              25 = INVALID MED REVIEW INDICATOR              *
015800*                                                             *
015900*              30 = INVALID MSA CODE                          *
016000*                                                             *
016100*              35 = INVALID INITIAL PAYMENT INDICATOR         *
016200*                        0 = MAKE NORMAL INITIAL PAYMENT      *
016300*                        1 = MAKE ZERO PAYMANT                *
016400*                                                             *
016500*              40 = FROM DATE  < OCT 1, 2000 OR INVALID       *
016600*                   THRU DATE  < OCT 1, 2000 OR INVALID       *
016700*                   ADMIT DATE < OCT 1, 2000 OR INVALID       *
016800*                                                             *
016900*              70 = INVALID OR NO HRG CODE PRESENT            *
017000*                                                             *
017100*              75 = NO HRG PRESENT IN FIRST OCCURANCE AND     *
017200*                   REVENUE-QTY-COV-VISITS > 4  AND           *
017300*                       TOB = 329,339,327,337                 *
017400*                          OR 32G OR 33G OR 32I OR 33I        *
017500*                          OR 32J OR 33J OR 32M OR 33M        *
017600*                          OR 32F OR 32K OR 32P OR 32H
017700*                          OR 33F OR 33K OR 33P OR 33H
017800*                                                             *
017900*              80 = INVALID REVENUE CODE                      *
018000*                                                             *
018100*              85 = NO REVENUE CODE PRESENT                   *
018200*                   WITH TOB 329 OR 339 OR 327 OR 337         *
018300*                         OR 32G OR 33G OR 32I OR 33I         *
018400*                         OR 32J OR 33J OR 32M OR 33M         *
018500*                         OR 32F OR 32K OR 32P OR 32H
018600*                         OR 33F OR 33K OR 33P OR 33H
018700*                                                             *
018800***************************************************************
018900******************************************************************
019000 DATE-COMPILED.
019100 ENVIRONMENT                     DIVISION.
019200
019300 CONFIGURATION                   SECTION.
019400 SOURCE-COMPUTER.                IBM-370.
019500 OBJECT-COMPUTER.                IBM-370.
019600
019700 INPUT-OUTPUT SECTION.
019800 FILE-CONTROL.
019900
020000     SELECT MSAFILE    ASSIGN TO UT-S-MSAFILE
020100         FILE STATUS IS MSA-STAT.
020200     SELECT CBSAFILE   ASSIGN TO UT-S-CBSAFILE
020300         FILE STATUS IS CBSA-STAT.
020400     SELECT HRGTABL    ASSIGN TO UT-S-HRGTABL
020500         FILE STATUS IS HRG-STAT.
020600     SELECT REVTABL    ASSIGN TO UT-S-REVTABL
020700         FILE STATUS IS REV-STAT.
020800
020900 DATA DIVISION.
021000 FILE SECTION.
021100
021200 FD  MSAFILE
021300     RECORDING MODE IS F
021400     BLOCK CONTAINS 133 RECORDS
021500     LABEL RECORDS ARE STANDARD.
021600 01  MSA-REC.
021700     05  MSA-CODE.
021800         10  MSA-BLANK            PIC X(02).
021900         10  MSA-STATE            PIC X(02).
022000     05  FILLER                   PIC X.
022100     05  MSA-EFFDATE              PIC X(08).
022200     05  FILLER                   PIC X.
022300     05  MSA-WAGEIND              PIC 9(02)V9(04).
022400     05  FILLER                   PIC X(08).
022500     05  MSA-NAME                 PIC X(52).
022600
022700 FD  CBSAFILE
022800     RECORDING MODE IS F
022900     BLOCK CONTAINS 133 RECORDS
023000     LABEL RECORDS ARE STANDARD.
023100 01  F-CBSA-REC.
023200     05  F-CBSA.
023300         10  F-CBSA-BLANK            PIC X(03).
023400         10  F-CBSA-STATE            PIC X(02).
023500     05  FILLER                   PIC X.
023600     05  F-CBSA-EFFDATE           PIC X(08).
023700     05  FILLER                   PIC X.
023800     05  F-CBSA-WAGEIND           PIC 9(02)V9(04).
023900     05  FILLER                   PIC X(08).
024000     05  F-CBSA-NAME              PIC X(51).
024100
024200 FD  HRGTABL
024300     RECORDING MODE IS F
024400     BLOCK CONTAINS 133 RECORDS
024500     LABEL RECORDS ARE STANDARD.
024600 01  HRG-TABL-REC.
024700     05  HRG-CODE                 PIC X(05).
024800     05  FILLER                   PIC X.
024900     05  HRG-EFFDATE              PIC X(08).
025000     05  FILLER                   PIC X.
025100     05  HRG-WGTS                 PIC 9(02)V9(04).
025200     05  FILLER                   PIC X.
025300     05  HRG-CODE2                PIC X(05).
025400     05  FILLER                   PIC X.
025500     05  HRG-WGTS2                PIC 9(02)V9(04).
025600     05  FILLER                   PIC X(46).
025700
025800 FD  REVTABL
025900     RECORDING MODE IS F
026000     BLOCK CONTAINS 133 RECORDS
026100     LABEL RECORDS ARE STANDARD.
026200 01  REV-TABL-REC.
026300     05  REV-CODE                       PIC X(04).
026400     05  FILLER                         PIC X.
026500     05  REV-EFFDATE                    PIC X(08).
026600     05  FILLER                         PIC X.
026700     05  REV-DOLL-RATE-NRURAL           PIC 9(07)V9(02).
026800     05  FILLER                         PIC X.
026900     05  REV-DOLL-RATE-RURAL            PIC 9(07)V9(02).
027000     05  FILLER                         PIC X.
027100     05  REV-DOLL-RATE-NRURAL-NOSUBMIT  PIC 9(07)V9(02).
027200     05  FILLER                         PIC X.
027300     05  REV-DOLL-RATE-RURAL-NOSUBMIT   PIC 9(07)V9(02).
027400     05  FILLER                         PIC X(27).
027500
027600 WORKING-STORAGE SECTION.
027700 77  W-STORAGE-REF               PIC X(49)  VALUE
027800     'HHA D R I V E R   - W O R K I N G   S T O R A G E'.
027900 01  OPN-VERSION                 PIC X(07)  VALUE 'O2016.0'.
028000 01  DRV-VERSION                 PIC X(07)  VALUE 'D2016.0'.
028100 01  HHCAL014                    PIC X(08)  VALUE 'HHCAL015'.
028200 01  HHCAL021                    PIC X(08)  VALUE 'HHCAL022'.
028300 01  HHCAL031                    PIC X(08)  VALUE 'HHCAL032'.
028400 01  HHCAL042                    PIC X(08)  VALUE 'HHCAL043'.
028500 01  HHCAL051                    PIC X(08)  VALUE 'HHCAL052'.
028600 01  HHCAL064                    PIC X(08)  VALUE 'HHCAL065'.
028700 01  HHCAL072                    PIC X(08)  VALUE 'HHCAL073'.
028800 01  HHCAL086                    PIC X(08)  VALUE 'HHCAL087'.
028900 01  HHCAL093                    PIC X(08)  VALUE 'HHCAL094'.
029000 01  HHCAL106                    PIC X(08)  VALUE 'HHCAL10C'.
029100 01  HHCAL107                    PIC X(08)  VALUE 'HHCAL109'.
029200 01  HHCAL111                    PIC X(08)  VALUE 'HHCAL111'.
029300 01  HHCAL120                    PIC X(08)  VALUE 'HHCAL120'.
029400 01  HHCAL131                    PIC X(08)  VALUE 'HHCAL131'.
029500 01  HHCAL144                    PIC X(08)  VALUE 'HHCAL144'.
029500 01  HHCAL152                    PIC X(08)  VALUE 'HHCAL152'.
029500 01  HHCAL160                    PIC X(08)  VALUE 'HHCAL160'.
029600 01  HHDRV160                    PIC X(08)  VALUE 'HHDRV160'.
029700 01  SUB1                        PIC 9(03)  VALUE 0.
029800 01  EOF-SW                      PIC 9(01)  VALUE 0.
029900 01  EOF-MSA                     PIC 9(01)  VALUE 0.
030000 01  EOF-CBSA                    PIC 9(01)  VALUE 0.
030100 01  EOF-HRG                     PIC 9(01)  VALUE 0.
030200 01  EOF-REV                     PIC 9(01)  VALUE 0.
030300 01  LOAD-TABLES-SW              PIC 9(01)  VALUE 0.
030400 01  TABLES-LOADED-SW            PIC 9(01)  VALUE 0.
030500 01  HRG-CT                      PIC 9(10)  VALUE 0.
030600 01  MSA-STAT.
030700     05  MSA-STAT1               PIC X.
030800     05  MSA-STAT2               PIC X.
030900 01  CBSA-STAT.
031000     05  CBSA-STAT1               PIC X.
031100     05  CBSA-STAT2               PIC X.
031200 01  HRG-STAT.
031300     05  HRG-STAT1               PIC X.
031400     05  HRG-STAT2               PIC X.
031500 01  REV-STAT.
031600     05  REV-STAT1               PIC X.
031700     05  REV-STAT2               PIC X.
031800*******************************************************
031900*    PASSED TO HHDRV PROGRAM                          *
032000*******************************************************
032100 01  WAGE-INDEX-DATA.
032200     02  WIR-MSA               PIC X(04).
032300     02  WIR-EFFDATE           PIC X(08).
032400     02  WIR-AREA-WAGEIND      PIC 9(02)V9(04).
032500
032600 01  MSA-WI-TABLE.
032700     05  M-MSA-DATA        OCCURS 4000
032800                           INDEXED BY MU1 MU2 MU3.
032900         10  TB-MSA        PIC X(04).
033000         10  FILLER        PIC X(01).
033100         10  TB-EFFDATE    PIC X(08).
033200         10  FILLER        PIC X(01).
033300         10  TB-WAGEIND    PIC 9(02)V9(04).
033400
033500 01  CBSA-WAGE-INDEX-DATA.
033600     02  WIR-CBSA              PIC X(05).
033700     02  WIR-CBSA-EFFDATE      PIC X(08).
033800     02  WIR-CBSA-WAGEIND      PIC 9(02)V9(04).
033900
034000 01  CBSA-WI-TABLE.
034100     05  T-CBSA-DATA        OCCURS 6000
034200                           INDEXED BY MA1 MA2 MA3.
034300         10  T-CBSA            PIC X(05).
034400         10  FILLER            PIC X(01).
034500         10  T-CBSA-EFFDATE    PIC X(08).
034600         10  FILLER            PIC X(01).
034700         10  T-CBSA-WAGEIND    PIC 9(02)V9(04).
034800
034900 01  HRG-WI-TABLE.
035000     05  M-HRG-DATA        OCCURS 4000
035100                           INDEXED BY HU1 HU2 HU3.
035200         10  TB-HRG-HRG        PIC X(05).
035300         10  FILLER            PIC X(01).
035400         10  TB-HRG-EFFDATE    PIC X(08).
035500         10  FILLER            PIC X(01).
035600         10  TB-HRG-WGTS       PIC 9(02)V9(04).
035700         10  FILLER            PIC X(01).
035800         10  TB-HRG-HRG2       PIC X(05).
035900         10  FILLER            PIC X(01).
036000         10  TB-HRG-WGTS2      PIC 9(02)V9(04).
036100
036200 01  REVENUE-TABLE.
036300     05  M-REV-DATA        OCCURS 200
036400                           INDEXED BY RU1 RU2 RU3.
036500         10  TB-REV-CODE.
036600             15  TB-REV-CODE-1ST.
036700                 88  TB-REV-CODE-RURAL-CHECK   VALUE '99'.
036800                 20  TB-REV-CODE-RURAL       PIC XX.
036900             15  TB-REV-CODE-2ND          PIC XX.
037000         10  FILLER                       PIC X(01).
037100         10  TB-REV-EFFDATE               PIC X(08).
037200         10  FILLER                       PIC X(01).
037300         10  TB-REV-DOLL-RATE-NRURAL      PIC 9(07)V9(02).
037400         10  FILLER                       PIC X(01).
037500         10  TB-REV-DOLL-RATE-RURAL       PIC 9(07)V9(02).
037600         10  FILLER                       PIC X.
037700         10  TB-DOLL-RATE-NRURAL-NOSUBMIT PIC 9(07)V9(02).
037800         10  FILLER                       PIC X.
037900         10  TB-DOLL-RATE-RURAL-NOSUBMIT  PIC 9(07)V9(02).
038000
038100 LINKAGE SECTION.
038200*******************************************************
038300* NATIONAL HHA RECORD FORMAT PASSED TO HHCAL PROGRAM  *
038400*******************************************************
038500 01  HHA-INPUT-DATA.
038600     05  HHA-DATA.
038700         10  HHA-NPI                 PIC X(10).
038800         10  HHA-HIC                 PIC X(12).
038900         10  HHA-PROV-NO             PIC X(06).
039000         10  HHA-TOB                 PIC XXX.
039100         10  HHA-PEP-INDICATOR       PIC X.
039200         10  HHA-PEP-DAYS            PIC 999.
039300         10  HHA-INIT-PAY-INDICATOR  PIC X.
039400             88  HHA-WITH-DATA-CHECK VALUE '0', '1'.
039500             88  HHA-NO-DATA-CHECK   VALUE '2', '3'.
039600         10  FILLER                  PIC X(07).
039700         10  HHA-MSA1                PIC 9(07)V9(02).
039800         10  HHA-MSA2-DATA REDEFINES HHA-MSA1.
039900             15  FILLER             PIC XXX.
040000             15  HHA-MSA2.
040100                 20  HHA-MSA2-1ST.
040200                     25  HHA-MSA2-RURAL        PIC XX.
040300                         88  HHA-MSA2-RURAL-CHECK  VALUE '99'.
040400                 20  HHA-MSA2-2ND              PIC XX.
040500             15  FILLER             PIC XX.
040600         10  HHA-CBSA-DATA REDEFINES HHA-MSA1.
040700             15  FILLER             PIC XX.
040800             15  HHA-CBSA.
040900                 20  HHA-CBSA-1ST.
041000                     25  HHA-CBSA-RURAL        PIC XXX.
041100                         88  HHA-CBSA-RURAL-CHECK  VALUE '999'.
041200                 20  HHA-CBSA-2ND              PIC XX.
041300             15  FILLER             PIC XX.
041400         10  HHA-SERV-FROM-DATE.
041500             15  HHA-FROM-CC         PIC XX.
041600             15  HHA-FROM-YYMMDD.
041700                 25  HHA-FROM-YY     PIC XX.
041800                 25  HHA-FROM-MM     PIC XX.
041900                 25  HHA-FROM-DD     PIC XX.
042000         10  HHA-SERV-THRU-DATE.
042100             15  HHA-THRU-CC         PIC XX.
042200             15  HHA-THRU-YYMMDD.
042300                 25  HHA-THRU-YY     PIC XX.
042400                 25  HHA-THRU-MM     PIC XX.
042500                 25  HHA-THRU-DD     PIC XX.
042600         10  HHA-ADMIT-DATE.
042700             15  HHA-ADMIT-CC        PIC XX.
042800             15  HHA-ADMIT-YYMMDD.
042900                 25  HHA-ADMIT-YY    PIC XX.
043000                 25  HHA-ADMIT-MM    PIC XX.
043100                 25  HHA-ADMIT-DD    PIC XX.
043200         10  HHA-HRG-DATA      OCCURS 6.
043300             15  HHA-MED-REVIEW-INDICATOR PIC X.
043400             15  HHA-HRG-INPUT-CODE       PIC X(05).
043500             15  HHA-HRG-OUTPUT-CODE      PIC X(05).
043600             15  HHA-HRG-NO-OF-DAYS       PIC 9(03).
043700             15  HHA-HRG-WGTS             PIC 9(02)V9(04).
043800             15  HHA-HRG-PAY              PIC 9(07)V9(02).
043900         10  HHA-REVENUE-DATA     OCCURS 6.
044000             15  HHA-REVENUE-CODE                PIC X(04).
044100             15  HHA-REVENUE-QTY-COV-VISITS      PIC 9(03).
044200             15  H-HHA-REVENUE-EARLIEST-DATE     PIC 9(08).
044300             15  HHA-REVENUE-DOLL-RATE           PIC 9(07)V9(02).
044400             15  HHA-REVENUE-COST                PIC 9(07)V9(02).
044500             15  H-HHA-REVENUE-ADD-ON-VISIT-AMT  PIC 9(07)V9(02).
044600     05  HHA-PASSBACK-DATA.
044700         10  HHA-PAY-RTC                PIC 99.
044800         10  HHA-REVENUE-SUM1-3-QTY-THR PIC 9(05).
044900         10  HHA-REVENUE-SUM1-6-QTY-ALL PIC 9(05).
045000         10  HHA-OUTLIER-PAYMENT        PIC 9(07)V9(02).
045100         10  HHA-TOTAL-PAYMENT          PIC 9(07)V9(02).
045200     05  HHA-CASE-MIX-DATA.
045300         10  HHA-LUPA-ADD-ON-PAYMENT    PIC 9(03)V9(02).
045400         10  HHA-LUPA-SRC-ADM           PIC X.
045500         10  HHA-RECODE-IND             PIC X.
045600         10  HHA-EPISODE-TIMING         PIC 9.
045700         10  HHA-SEVERITY-POINTS.
045800             15  HHA-CLINICAL-SEV-EQ1   PIC X(01).
045900             15  HHA-FUNCTION-SEV-EQ1   PIC X(01).
046000             15  HHA-CLINICAL-SEV-EQ2   PIC X(01).
046100             15  HHA-FUNCTION-SEV-EQ2   PIC X(01).
046200             15  HHA-CLINICAL-SEV-EQ3   PIC X(01).
046300             15  HHA-FUNCTION-SEV-EQ3   PIC X(01).
046400             15  HHA-CLINICAL-SEV-EQ4   PIC X(01).
046500             15  HHA-FUNCTION-SEV-EQ4   PIC X(01).
046600     05  HHA-PROV-TOTAL-DATA.
046700         10  HHA-PROV-OUTLIER-PAY-TOTAL PIC 9(08)V9(02).
046800         10  HHA-PROV-PAYMET-TOTAL      PIC 9(09)V9(02).
046900     05  FILLER                         PIC X(31).
047000**==================================================***
047100*    05  FILLER                         PIC X(20).
047200**==================================================***
047300*    RETURNED BY HHCAL PROGRAM AND PASSED ON TO MGR   *
047400**==================================================***
047500 01  HOLD-VARIABLES-DATA.
047600     02  HOLD-VAR-DATA.
047700         05  PRICER-OPTION-SW              PIC X(01).
047800         05  HHOPN-VERSION                 PIC X(07).
047900         05  HHDRV-VERSION                 PIC X(07).
048000         05  HHCAL-VERSION                 PIC X(07).
048100         05  FILLER                        PIC X(20).
048200
048300
048400**==================================================***
048500 PROCEDURE  DIVISION USING HHA-INPUT-DATA
048600                           HOLD-VARIABLES-DATA.
048700
048800 0000-MAINLINE  SECTION.
048900
049000     MOVE OPN-VERSION TO HHOPN-VERSION.
049100
049200**** IF PRICER-OPTION-SW = 'A'
049300        IF TABLES-LOADED-SW NOT NUMERIC
049400            MOVE 1 TO TABLES-LOADED-SW.
049500
049600        IF TABLES-LOADED-SW = 0
049700            PERFORM 1100-LOAD-CBSAFILE THRU 1100-EXIT
049800            PERFORM 1300-LOAD-MSAFILE THRU 1300-EXIT
049900            PERFORM 1800-LOAD-HRGTABL THRU 1800-EXIT
050000            PERFORM 2500-LOAD-REVTABL THRU 2500-EXIT
050100            MOVE 1 TO TABLES-LOADED-SW.
050200
050300
050400     MOVE ALL '0' TO HHA-PASSBACK-DATA.
050500
050600 0100-PROCESS-RECORDS.
050700
050800*******************************************************
050900*****    FY 2016 VERSION 0
051000***
051100         CALL HHDRV160 USING WAGE-INDEX-DATA
051200                             MSA-WI-TABLE
051300                             CBSA-WAGE-INDEX-DATA
051400                             CBSA-WI-TABLE
051500                             HRG-WI-TABLE
051600                             REVENUE-TABLE
051700                             HHA-INPUT-DATA
051800                             HOLD-VARIABLES-DATA.
051900         GOBACK.
052000
052100
052200*******************************************************
052300
052400 0100-EXIT.  EXIT.
052500
052600
052700 1100-LOAD-CBSAFILE.
052800     OPEN INPUT CBSAFILE.
052900     INITIALIZE CBSA-WI-TABLE.
053000     MOVE 0 TO EOF-CBSA.
053100     SET MA3 TO EOF-CBSA.
053200
053300     PERFORM 1200-READ-CBSAFILE THRU 1200-EXIT
053400             UNTIL EOF-CBSA = 1.
053500
053600     CLOSE CBSAFILE.
053700
053800 1100-EXIT.  EXIT.
053900
054000 1200-READ-CBSAFILE.
054100     READ CBSAFILE
054200          AT END   MOVE 1 TO EOF-CBSA.
054300
054400     IF EOF-CBSA = 0
054500        IF F-CBSA-EFFDATE > '20050930' OR
054600          (F-CBSA-STATE = '98' OR '99')
054700           SET MA3 UP BY 1
054800               MOVE F-CBSA         TO T-CBSA         (MA3)
054900               MOVE F-CBSA-EFFDATE TO T-CBSA-EFFDATE (MA3)
055000               MOVE F-CBSA-WAGEIND TO T-CBSA-WAGEIND (MA3).
055100
055200 1200-EXIT.  EXIT.
055300
055400 1300-LOAD-MSAFILE.
055500     OPEN INPUT MSAFILE.
055600     INITIALIZE MSA-WI-TABLE.
055700     MOVE 0 TO EOF-MSA.
055800     SET MU3 TO EOF-MSA.
055900
056000     PERFORM 1400-READ-MSAFILE THRU 1400-EXIT
056100             UNTIL EOF-MSA = 1.
056200
056300     CLOSE MSAFILE.
056400
056500 1300-EXIT.  EXIT.
056600
056700 1400-READ-MSAFILE.
056800     READ MSAFILE
056900          AT END   MOVE 1 TO EOF-MSA.
057000
057100     IF EOF-MSA = 0
057200        IF MSA-EFFDATE > '19970930' OR
057300          (MSA-STATE = '98' OR '99')
057400           SET MU3 UP BY 1
057500               MOVE MSA-CODE    TO TB-MSA     (MU3)
057600               MOVE MSA-EFFDATE TO TB-EFFDATE (MU3)
057700               MOVE MSA-WAGEIND TO TB-WAGEIND (MU3).
057800
057900 1400-EXIT.  EXIT.
058000
058100
058200 1800-LOAD-HRGTABL.
058300     OPEN INPUT HRGTABL.
058400     INITIALIZE HRG-WI-TABLE.
058500     MOVE 0 TO EOF-HRG.
058600     SET HU3 TO EOF-HRG.
058700
058800     PERFORM 1900-READ-HRGTABL THRU 1900-EXIT
058900             UNTIL EOF-HRG = 1.
059000
059100     CLOSE HRGTABL.
059200
059300 1800-EXIT.  EXIT.
059400
059500 1900-READ-HRGTABL.
059600     READ HRGTABL
059700          AT END   MOVE 1 TO EOF-HRG.
059800     ADD 1 TO HRG-CT.
059900     IF EOF-HRG = 0
060000        SET HU3 UP BY 1
060100            MOVE HRG-CODE     TO TB-HRG-HRG      (HU3)
060200            MOVE HRG-EFFDATE  TO TB-HRG-EFFDATE  (HU3)
060300            MOVE HRG-WGTS     TO TB-HRG-WGTS     (HU3)
060400            MOVE HRG-CODE2    TO TB-HRG-HRG2     (HU3)
060500            MOVE HRG-WGTS2    TO TB-HRG-WGTS2    (HU3).
060600
060700 1900-EXIT.  EXIT.
060800
060900
061000 2500-LOAD-REVTABL.
061100     OPEN INPUT REVTABL.
061200     INITIALIZE REVENUE-TABLE.
061300     MOVE 0 TO EOF-REV.
061400     SET RU3 TO EOF-REV.
061500
061600     PERFORM 2600-READ-REVTABL THRU 2600-EXIT
061700             UNTIL EOF-REV = 1.
061800
061900     CLOSE REVTABL.
062000
062100 2500-EXIT.  EXIT.
062200
062300 2600-READ-REVTABL.
062400     READ REVTABL
062500          AT END   MOVE 1 TO EOF-REV.
062600
062700     IF EOF-REV = 0
062800        SET RU3 UP BY 1
062900            MOVE REV-CODE      TO TB-REV-CODE     (RU3)
063000            MOVE REV-EFFDATE   TO TB-REV-EFFDATE  (RU3)
063100            MOVE REV-DOLL-RATE-NRURAL TO
063200                              TB-REV-DOLL-RATE-NRURAL (RU3)
063300            MOVE REV-DOLL-RATE-RURAL TO
063400                              TB-REV-DOLL-RATE-RURAL (RU3)
063500            MOVE REV-DOLL-RATE-NRURAL-NOSUBMIT TO
063600                          TB-DOLL-RATE-NRURAL-NOSUBMIT (RU3)
063700            MOVE REV-DOLL-RATE-RURAL-NOSUBMIT TO
063800                         TB-DOLL-RATE-RURAL-NOSUBMIT (RU3)
063900     END-IF.
064000
064100 2600-EXIT.  EXIT.
064200
064300
064400
064500*****        LAST STATEMENT               *************
